home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 4 Database How-To / Visual Basic 4 Database - How-to (The Waite Group)(1995).iso / tablist.fr_ / tablist.fr
Text File  |  1994-12-27  |  5KB  |  176 lines
  1. VERSION 4.00
  2. Begin VB.Form frmTableList
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   3  'Fixed Double
  5.    Caption         =   "Current Tables"
  6.    ClientHeight    =   4275
  7.    ClientLeft      =   1605
  8.    ClientTop       =   1560
  9.    ClientWidth     =   3735
  10.    BeginProperty Font
  11.       name            =   "MS Sans Serif"
  12.       charset         =   1
  13.       weight          =   700
  14.       size            =   8.25
  15.       underline       =   0   'False
  16.       italic          =   0   'False
  17.       strikethrough   =   0   'False
  18.    EndProperty
  19.    Height          =   4680
  20.    Left            =   1545
  21.    LinkTopic       =   "Form1"
  22.    MaxButton       =   0   'False
  23.    MinButton       =   0   'False
  24.    ScaleHeight     =   4275
  25.    ScaleWidth      =   3735
  26.    Top             =   1215
  27.    Width           =   3855
  28.    Begin VB.CommandButton cmdDelete
  29.       Caption         =   "&Delete"
  30.       Height          =   615
  31.       Left            =   300
  32.       TabIndex        =   2
  33.       Top             =   3120
  34.       Width           =   1275
  35.    End
  36.    Begin VB.CommandButton cmdClose
  37.       Cancel          =   -1  'True
  38.       Caption         =   "Close"
  39.       Default         =   -1  'True
  40.       Height          =   615
  41.       Left            =   1980
  42.       TabIndex        =   1
  43.       Top             =   3120
  44.       Width           =   1275
  45.    End
  46.    Begin VB.ListBox lstTables
  47.       Height          =   2175
  48.       Left            =   540
  49.       Sorted          =   -1  'True
  50.       TabIndex        =   0
  51.       Top             =   420
  52.       Width           =   2595
  53.    End
  54. End
  55. Attribute VB_Name = "frmTableList"
  56. Attribute VB_Creatable = False
  57. Attribute VB_Exposed = False
  58. Option Explicit
  59.  
  60. ' Modify the path to point to your copy of BIBLIO.MDB.
  61. Const DATABASE_NAME = "D:\VB4\BIBLIO.MDB"
  62.  
  63. Private Sub Form_Load()
  64.  
  65.     ' Fill the list box with the current non-system tables in DATABASE_NAME.
  66.     ListTables
  67.     
  68. End Sub
  69.  
  70. Private Sub ListTables()
  71.     Dim db As Database
  72.     Dim td As TableDef
  73.  
  74.     On Error GoTo ListError
  75.  
  76.     Screen.MousePointer = 11
  77.  
  78.     lstTables.Clear
  79.     Set db = DBEngine.Workspaces(0).OpenDatabase(DATABASE_NAME)
  80.     
  81.     ' Cycle through the table definitions in DATABASE_NAME.
  82.     ' If the table is a system table (name begins with MSys), ignore it.
  83.     ' Otherwise, add it to the list.
  84.     For Each td In db.TableDefs
  85.         If Left$(td.Name, 4) <> "MSys" Then lstTables.AddItem td.Name
  86.     Next
  87.  
  88.     Screen.MousePointer = 0
  89.  
  90. Exit Sub
  91. ListError:
  92.     Screen.MousePointer = 0
  93.     MsgBox Error$, vbExclamation
  94.     Unload frmTableList
  95. Exit Sub
  96. End Sub
  97.  
  98. Private Sub cmdDelete_Click()
  99.     Dim db As Database
  100.  
  101.     on error goto DeleteError
  102.     
  103.     Screen.MousePointer = 11
  104.     
  105.     ' If the user has selected a table, proceed.
  106.     If lstTables.ListIndex > -1 Then
  107.     
  108.         ' If the table has no records, proceed.
  109.         If TableIsEmpty() Then
  110.         
  111.             ' Delete the selected table from DATABASE_NAME.
  112.             Set db = DBEngine.Workspaces(0).OpenDatabase(DATABASE_NAME)
  113.             db.Execute ("DROP TABLE [" & lstTables.Text & "]")
  114.             
  115.             ' Display the modified list of tables.
  116.             ListTables
  117.         
  118.         Else
  119.                 
  120.             ' The table has records, so inform the user.
  121.             Screen.MousePointer = 11
  122.             MsgBox lstTables.Text & " is not empty.", vbExclamation
  123.             
  124.         End If
  125.         
  126.         Screen.MousePointer = 0
  127.         
  128.     Else
  129.         Screen.MousePointer = 0
  130.         MsgBox "You have not selected a table to delete.", vbExclamation
  131.     End If
  132.  
  133. Exit Sub
  134.  
  135. DeleteError:
  136.     Screen.MousePointer = 0
  137.     MsgBox Error$
  138.     Unload frmTableList
  139. Exit Sub
  140.  
  141. End Sub
  142.  
  143. Function TableIsEmpty() As Boolean
  144.     Dim db As Database
  145.     Dim td As TableDef
  146.     
  147.     On Error Goto TableIsEmptyError
  148.  
  149.     Set db = DBEngine.Workspaces(0).OpenDatabase(DATABASE_NAME)
  150.     
  151.     ' Cycle through the table definitions in DATABASE_NAME.
  152.     ' When the table currently selected in lstTables is found, check to
  153.     ' see whether it has records. If it does not, return True; otherwise,
  154.     ' return False.
  155.     For Each td In db.TableDefs
  156.         If td.Name = lstTables.Text Then
  157.             TableIsEmpty = IIf(td.RecordCount = 0, True, False)
  158.             Exit For
  159.         End If
  160.     Next
  161.     
  162. Exit Function
  163.  
  164. TableIsEmptyError:
  165.     MsgBox Error$
  166.     Unload frmTableList
  167. Exit Function
  168.  
  169. End Function
  170.  
  171. Private Sub cmdClose_Click()
  172.     Unload frmTableList
  173. End Sub
  174.  
  175.  
  176.